home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / skk / string.el.z / string.el
Encoding:
Text File  |  1998-05-21  |  5.3 KB  |  163 lines
  1. ;;;; $Id: string.el,v 1.1.1.1 1997/08/21 12:20:32 mrt Exp $
  2. ;;;; This file contains some miscellaneous string functions
  3.  
  4. ;; Copyright (C) 1991-1995 Free Software Foundation
  5.  
  6. ;; Author: Sebastian Kremer <sk@thp.Uni-Koeln.DE>
  7. ;;    Per Cederqvist <ceder@lysator.liu.se>
  8. ;;    Inge Wallin <inge@lysator.liu.se>
  9. ;; Maintainer: elib-maintainers@lysator.liu.se
  10. ;; Created: before 9 May 1991
  11. ;; Keywords: extensions, lisp
  12.  
  13. ;;;; This file is part of the GNU Emacs lisp library, Elib.
  14. ;;;;
  15. ;;;; GNU Elib is free software; you can redistribute it and/or modify
  16. ;;;; it under the terms of the GNU General Public License as published by
  17. ;;;; the Free Software Foundation; either version 2, or (at your option)
  18. ;;;; any later version.
  19. ;;;;
  20. ;;;; GNU Elib is distributed in the hope that it will be useful,
  21. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. ;;;; GNU General Public License for more details.
  24. ;;;;
  25. ;;;; You should have received a copy of the GNU General Public License
  26. ;;;; along with GNU Elib; see the file COPYING.  If not, write to
  27. ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28. ;;;; Boston, MA 02111-1307, USA
  29. ;;;; 
  30. ;;;; Author: Sebastian Kremer
  31. ;;;;         sk@thp.Uni-Koeln.DE
  32. ;;;; 
  33.  
  34.  
  35. ;;; Commentary:
  36.  
  37. ;;;
  38. ;;; This file is part of the elisp library Elib.
  39. ;;; It implements simple generic string functions for use in other 
  40. ;;; elisp code: replace regexps in strings, split strings on regexps.
  41. ;;; 
  42.  
  43.  
  44. ;;; Code:
  45.  
  46. (require 'queue-m)
  47. (provide 'string)
  48.  
  49.  
  50. ;; This function is a near-equivalent of the elisp function replace-match
  51. ;; which work on strings instead of a buffer.  The FIXEDCASE parameter
  52. ;; of replace-match is not implemented.
  53.  
  54. (defun string-replace-match (regexp string newtext &optional literal global)
  55.   "Replace first match of REGEXP in STRING with NEWTEXT.
  56. If no match is found, nil is returned instead of the new string.
  57.  
  58. Optional arg LITERAL non-nil means to take NEWTEXT literally. If LITERAL is 
  59. nil, character `\\' is the start of one of the following sequences:
  60.   \\\\   will be replaced by a single \\.
  61.   \\&   will be replaced by the text which matched the regexp.
  62.   \\N   where N is a number and 1 <= N <= 9, will be replaced
  63.        by the Nth subexpression in REGEXP. Subexpressions are grouped
  64.        inside \\( \\).
  65.  
  66. Optional arg GLOBAL means to replace all matches instead of only the first."
  67.  
  68.   (let ((data (match-data)))
  69.     (unwind-protect
  70.  
  71.     (if global
  72.         (let ((result "") 
  73.           (start 0)
  74.           matchbeginning
  75.           matchend)
  76.           (while (string-match regexp string start)
  77.         (setq matchbeginning (match-beginning 0)
  78.               matchend (match-end 0)
  79.               result (concat result
  80.                      (substring string start matchbeginning)
  81.                      (if literal
  82.                      newtext
  83.                        (elib-string-expand-newtext string
  84.                                                                    newtext )))
  85.               start matchend))
  86.  
  87.           (if matchbeginning    ; matched at least once
  88.           (concat result (substring string start))
  89.         nil))
  90.  
  91.       ;; not GLOBAL
  92.       (if (not (string-match regexp string 0))
  93.           nil
  94.         (concat (substring string 0 (match-beginning 0))
  95.             (if literal newtext (elib-string-expand-newtext string
  96.                                                                     newtext ))
  97.             (substring string (match-end 0)))))
  98.       (store-match-data data))))
  99.  
  100.  
  101. (defun elib-string-expand-newtext (string newtext)
  102.   ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT.
  103.   ;; Uses match data and fluid vars `newtext', `string'.
  104.   ;; Note that in Emacs 18 match data are clipped to current buffer
  105.   ;; size...so the buffer should better not be smaller than STRING.
  106.   (let ((pos 0)
  107.     (len (length newtext))
  108.     (expanded-newtext ""))
  109.     (while (< pos len)
  110.       (setq expanded-newtext
  111.         (concat expanded-newtext
  112.             (let ((c (aref newtext pos)))
  113.               (if (= ?\\ c)
  114.               (cond ((= ?\& (setq c (aref newtext
  115.                               (setq pos (1+ pos)))))
  116.                  (match-string 0 string) )
  117.                 ((and (>= c ?1) 
  118.                       (<= c ?9))
  119.                  ;; return empty string if N'th
  120.                  ;; sub-regexp did not match:
  121.                  (let ((n (- c ?0)))
  122.                    (if (match-beginning n)
  123.                        (substring string
  124.                           (match-beginning n)
  125.                           (match-end n))
  126.                      "")))
  127.                 (t (char-to-string c)))
  128.             (char-to-string c)))))
  129.       (setq pos (1+ pos)))
  130.     expanded-newtext))
  131.  
  132.  
  133. (defun string-split (pattern string &optional limit)
  134.   "Splitting on regexp PATTERN, turn string STRING into a list of substrings.
  135. Optional third arg LIMIT (>= 1) is a limit to the length of the
  136. resulting list."
  137.  
  138.   (let* ((data (match-data))
  139.          (start (string-match pattern string))
  140.          (result-q (queue-create))
  141.          (count 1)
  142.          (end (if start (match-end 0))) )
  143.     (unwind-protect
  144.     (progn
  145.           (queue-enqueue result-q (substring string 0 start))
  146.       (if end            ; else nothing left
  147.           (while (and (or (not (integerp limit))
  148.                   (< count limit))
  149.               (string-match pattern string end))
  150.         (setq start (match-beginning 0)
  151.                       count (1+ count) )
  152.                 (queue-enqueue result-q (substring string end start))
  153.                 (setq end (match-end 0)
  154.                       start end )))
  155.       (if (and (or (not (integerp limit))
  156.                (< count limit) )
  157.            end)            ; else nothing left
  158.           (queue-enqueue result-q (substring string end)) )
  159.           (queue-all result-q) )
  160.       (store-match-data data) )))
  161.  
  162. ;;; string.el ends here
  163.